-- | Example:
-- 
-- @
-- withPeriodicTimer 1_000_000 $ \timer -> forever $ do
--     beep
--     atomically $ retryUntilActivated timer
-- @
module Control.Concurrent.Timer where

import Control.Concurrent.STM
import Control.Concurrent.Async
import Control.Concurrent
import Control.Monad

type Timer = TMVar ()

retryUntilActivated :: Timer -> STM ()
retryUntilActivated = takeTMVar

-- | @withPeriodicTimer microseconds f@
withPeriodicTimer :: Int -> (Timer -> IO a) -> IO a
withPeriodicTimer period f = do
  signal <- atomically $ newEmptyTMVar
  withAsync
    (forever $ do
      threadDelay period
      atomically $ tryPutTMVar signal ()
    )
    (\_ -> f signal)

